Dane wykorzystane w niniejszej analizie zostały zebrane przez różne instytucje, głównie przez Bank Światowy. Zawierają one między innymi informacje na temat wskaźników gospodarczych państw w poszczególnych latach (1920-2020). Dodatkowo, w analizie zostały wykorzystane dane na temat obrotu bitcoinem, cen złota oraz miesięcznych wynikach S&P Composite. Dane zostały poddane czyszczeniu oraz licznym tranformacjom umożliwiającym analizę.
Analiza zbiorów danych obejmowała sprawdzenie najbardziej interesujących korelacji między poszczególnymi wskaźnikami gospodarczymi oraz próbę ich interpretacji. Została również sprawdzona korelacja między ceną bitcoina a kolumnami w zbiorze dotyczącym bitcoina, cen złota oraz S&P Composite w celu stworzenia regresora. Ponadto, przeanalizowana została populacja Chin, Indii oraz USA.
Model regresji przewidujący cenę bitcoina został stworzony z wykorzystaniem algorytmu lasso oraz ridge.
library("readxl")
library("dplyr")
library("tidyr")
library("tibble")
library("DT")
library("ggplot2")
library("gganimate")
library("gifski")
library("caret")
library("knitr")
library("ggcorrplot")
library("plotly")
library("gridExtra")
library("kableExtra")
Dane zostały wczytane z wykorzystaniem standardowej funkcji read.csv oraz read_excel pochodzącej z biblioteki readxl.
wdi <- read_excel("./data/World_Development_Indicators.xlsx")
sp_composite <- read.csv("./data/S&P Composite.csv")
gold_prices <- read.csv("./data/Gold Prices.csv")
bitcoin_diff <- read.csv("./data/Bitcoin/BCHAIN-DIFF.csv")
bitcoin_hrate <- read.csv("./data/Bitcoin/BCHAIN-HRATE.csv")
bitcoin_mkpru <- read.csv("./data/Bitcoin/BCHAIN-MKPRU.csv")
bitcoin_trvou <- read.csv("./data/Bitcoin/BCHAIN-TRVOU.csv")
Kolumna Series Name została przeniesiona ze zbioru wdi do zbioru wdi_names, ponieważ została uznana za zbędną i utrudniającą dalszą pracę na zbiorze danych - była opisem danego wskaźnika gospodarczego, którego identyfikator znajdował się w kolumnie Series Code. Usunięta została również kolumna Country Code, ponieważ nie została wykorzystana w dalszej analizie.
Czyszczenie zbioru wdi obejmowało:
Year.Series Code do postaci wielu kolumn.Year z yyyy [YRyyyy] na yyyy... zostały zamienione na NA.wdi_names <- wdi %>%
select("Series Code", "Series Name") %>%
distinct()
wdi_reshaped <- wdi %>%
select(-c("Series Name", "Country Code")) %>%
filter(!if_all(3:53, ~ . == ".."), na.rm = TRUE) %>%
gather("Year", "Value", 3:53) %>%
distinct() %>%
spread("Series Code", "Value") %>%
select(which(colMeans(!is.na(.) & . != "..") > 0.5)) %>%
mutate(Year = substr(Year, 0, 4)) %>%
mutate_at(3:115, function(x) as.numeric(x))
kable(summary(wdi_reshaped)) %>%
kable_styling("striped") %>%
scroll_box(width = "100%")
| Country Name | Year | AG.LND.TOTL.K2 | BG.GSR.NFSV.GD.ZS | BM.GSR.FCTY.CD | BM.GSR.MRCH.CD | BM.GSR.NFSV.CD | BN.GSR.FCTY.CD | BN.KLT.PTXL.CD | BX.GSR.FCTY.CD | BX.GSR.MRCH.CD | BX.GSR.NFSV.CD | BX.PEF.TOTL.CD.WD | DT.ODA.ODAT.CD | EG.ELC.ACCS.ZS | EG.ELC.COAL.ZS | EG.ELC.FOSL.ZS | EG.ELC.HYRO.ZS | EG.ELC.NGAS.ZS | EG.ELC.NUCL.ZS | EG.ELC.RNEW.ZS | EG.ELC.RNWX.KH | EG.ELC.RNWX.ZS | EG.FEC.RNEW.ZS | EN.ATM.CO2E.EG.ZS | EN.ATM.CO2E.GF.KT | EN.ATM.CO2E.GF.ZS | EN.ATM.CO2E.KD.GD | EN.ATM.CO2E.KT | EN.ATM.CO2E.LF.KT | EN.ATM.CO2E.LF.ZS | EN.ATM.CO2E.PC | EN.ATM.CO2E.SF.KT | EN.ATM.CO2E.SF.ZS | EN.ATM.GHGT.KT.CE | EN.ATM.METH.EG.KT.CE | EN.ATM.METH.KT.CE | EN.ATM.NOXE.EG.ZS | EN.ATM.NOXE.KT.CE | EN.CO2.BLDG.ZS | EN.CO2.ETOT.ZS | EN.CO2.MANF.ZS | EN.CO2.OTHX.ZS | EN.CO2.TRAN.ZS | EN.POP.DNST | EN.URB.LCTY | EN.URB.LCTY.UR.ZS | EN.URB.MCTY | FM.AST.DOMS.CN | FP.CPI.TOTL | FP.CPI.TOTL.ZG | IT.NET.USER.ZS | NE.DAB.TOTL.CD | NE.DAB.TOTL.ZS | NE.EXP.GNFS.CD | NE.EXP.GNFS.KD.ZG | NE.IMP.GNFS.CD | NE.IMP.GNFS.ZS | NE.TRD.GNFS.ZS | NV.IND.MANF.ZS | NV.SRV.TOTL.ZS | NY.GDP.MKTP.CD | NY.GDP.MKTP.KD.ZG | NY.GDP.NGAS.RT.ZS | NY.GDP.PCAP.CD | NY.GDP.PCAP.KD.ZG | NY.GDP.TOTL.RT.ZS | NY.GDS.TOTL.CD | NY.GDS.TOTL.ZS | NY.GNS.ICTR.CD | NY.GNS.ICTR.ZS | NY.GSR.NFCY.CD | NY.GSR.NFCY.CN | NY.TAX.NIND.CD | NY.TAX.NIND.CN | NY.TAX.NIND.KN | SE.PRM.AGES | SE.PRM.ENRL.TC.ZS | SE.SEC.ENRL | SH.DTH.MORT | SL.AGR.EMPL.ZS | SL.EMP.MPYR.ZS | SL.EMP.SELF.FE.ZS | SL.EMP.SELF.MA.ZS | SL.EMP.SELF.ZS | SL.IND.EMPL.ZS | SL.SRV.EMPL.ZS | SL.TLF.TOTL.IN | SP.DYN.CBRT.IN | SP.DYN.IMRT.IN | SP.DYN.LE00.IN | SP.DYN.TO65.FE.ZS | SP.DYN.TO65.MA.ZS | SP.POP.0014.TO.ZS | SP.POP.1564.TO.ZS | SP.POP.65UP.TO.ZS | SP.POP.GROW | SP.POP.TOTL | SP.POP.TOTL.FE.IN | SP.POP.TOTL.FE.ZS | SP.POP.TOTL.MA.IN | SP.POP.TOTL.MA.ZS | SP.RUR.TOTL | SP.RUR.TOTL.ZG | SP.RUR.TOTL.ZS | SP.URB.GROW | SP.URB.TOTL | SP.URB.TOTL.IN.ZS | TM.VAL.FOOD.ZS.UN | TM.VAL.FUEL.ZS.UN | TM.VAL.TRAN.ZS.WT | TX.VAL.FOOD.ZS.UN | TX.VAL.FUEL.ZS.UN | TX.VAL.MRCH.HI.ZS | TX.VAL.TRAN.ZS.WT | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Length:10608 | Length:10608 | Min. : 2 | Min. : 1.165 | Min. :-2.187e+08 | Min. :5.153e+06 | Min. :9.128e+05 | Min. :-1.052e+11 | Min. :-8.080e+11 | Min. :-5.061e+07 | Min. :1.991e+05 | Min. :0.000e+00 | Min. :-2.441e+11 | Min. :-9.899e+08 | Min. : 0.534 | Min. : 0.00 | Min. : 0.00 | Min. : 0.00 | Min. : 0.000 | Min. : 0.000 | Min. : 0.000 | Min. :0.000e+00 | Min. : 0.000 | Min. : 0.000 | Min. : 0.054 | Min. : -147 | Min. : -0.7295 | Min. :0.0000 | Min. : 0 | Min. : -161 | Min. : -6.089 | Min. : 0.000 | Min. : -114 | Min. : -4.324 | Min. : 1 | Min. : 0 | Min. : 0 | Min. : 0.000 | Min. : 0.0 | Min. : 0.000 | Min. : 0.00 | Min. : 0.00 | Min. :-2.326 | Min. : 0.00 | Min. : 0.136 | Min. : 18587 | Min. : 2.867 | Min. : 34329 | Min. :-5.424e+13 | Min. : 0.00 | Min. : -18.109 | Min. : 0.00 | Min. :1.805e+07 | Min. : 21.21 | Min. :6.933e+05 | Min. : -96.4 | Min. :0.000e+00 | Min. : 0.00 | Min. : 0.021 | Min. : 0.000 | Min. :10.86 | Min. :8.824e+06 | Min. :-64.047 | Min. : 0.0000 | Min. : 22.8 | Min. :-64.9924 | Min. : 0.000 | Min. :-7.622e+09 | Min. :-141.97 | Min. :-2.601e+10 | Min. :-236.27 | Min. :-9.905e+10 | Min. :-4.813e+14 | Min. :-1.444e+10 | Min. :-1.255e+14 | Min. :-9.832e+13 | Min. :4.000 | Min. : 5.226 | Min. : 0 | Min. : 0 | Min. : 0.030 | Min. : 0.000 | Min. : 0.07 | Min. : 0.39 | Min. : 0.41 | Min. : 0.28 | Min. : 5.34 | Min. :3.120e+04 | Min. : 5.90 | Min. : 1.50 | Min. :18.91 | Min. : 6.464 | Min. : 1.477 | Min. :11.05 | Min. :45.45 | Min. : 0.6856 | Min. :-10.9551 | Min. :5.740e+03 | Min. :2.586e+04 | Min. :23.29 | Min. :2.528e+04 | Min. :44.37 | Min. :0.000e+00 | Min. :-235.7924 | Min. : 0.00 | Min. :-187.142 | Min. :1.267e+03 | Min. : 2.845 | Min. : 0.474 | Min. : 0.009 | Min. : 0.292 | Min. : 0.000 | Min. : 0.000 | Min. : 0.0074 | Min. :-381.37 | |
| Class :character | Class :character | 1st Qu.: 17200 | 1st Qu.: 9.165 | 1st Qu.: 1.002e+08 | 1st Qu.:9.803e+08 | 1st Qu.:3.151e+08 | 1st Qu.:-1.296e+09 | 1st Qu.:-1.077e+08 | 1st Qu.: 2.704e+07 | 1st Qu.:5.762e+08 | 1st Qu.:2.022e+08 | 1st Qu.: 0.000e+00 | 1st Qu.: 3.095e+07 | 1st Qu.: 72.093 | 1st Qu.: 0.00 | 1st Qu.: 30.94 | 1st Qu.: 2.34 | 1st Qu.: 0.000 | 1st Qu.: 0.000 | 1st Qu.: 0.208 | 1st Qu.:0.000e+00 | 1st Qu.: 0.000 | 1st Qu.: 3.852 | 1st Qu.: 1.590 | 1st Qu.: 0 | 1st Qu.: 0.0000 | 1st Qu.:0.2443 | 1st Qu.: 1300 | 1st Qu.: 802 | 1st Qu.: 43.603 | 1st Qu.: 0.506 | 1st Qu.: 0 | 1st Qu.: 0.000 | 1st Qu.: 7530 | 1st Qu.: 160 | 1st Qu.: 1817 | 1st Qu.: 2.669 | 1st Qu.: 550.6 | 1st Qu.: 4.720 | 1st Qu.:22.43 | 1st Qu.:12.49 | 1st Qu.: 0.385 | 1st Qu.:16.84 | 1st Qu.: 23.438 | 1st Qu.: 610060 | 1st Qu.: 20.529 | 1st Qu.: 1078178 | 1st Qu.: 2.546e+09 | 1st Qu.: 26.11 | 1st Qu.: 2.338 | 1st Qu.: 0.14 | 1st Qu.:4.301e+09 | 1st Qu.: 97.72 | 1st Qu.:9.514e+08 | 1st Qu.: -0.3 | 1st Qu.:1.306e+09 | 1st Qu.: 24.52 | 1st Qu.: 45.548 | 1st Qu.: 7.914 | 1st Qu.:42.10 | 1st Qu.:2.366e+09 | 1st Qu.: 1.234 | 1st Qu.: 0.0000 | 1st Qu.: 734.0 | 1st Qu.: -0.3525 | 1st Qu.: 0.231 | 1st Qu.: 3.771e+08 | 1st Qu.: 11.01 | 1st Qu.: 6.971e+08 | 1st Qu.: 14.92 | 1st Qu.:-1.014e+09 | 1st Qu.:-1.152e+10 | 1st Qu.: 1.769e+08 | 1st Qu.: 4.764e+08 | 1st Qu.: 2.163e+09 | 1st Qu.:6.000 | 1st Qu.: 18.193 | 1st Qu.: 73632 | 1st Qu.: 676 | 1st Qu.: 7.025 | 1st Qu.: 1.240 | 1st Qu.:12.89 | 1st Qu.:19.73 | 1st Qu.:16.81 | 1st Qu.:14.23 | 1st Qu.:36.51 | 1st Qu.:1.115e+06 | 1st Qu.:15.02 | 1st Qu.: 12.70 | 1st Qu.:59.23 | 1st Qu.:60.525 | 1st Qu.:51.795 | 1st Qu.:23.37 | 1st Qu.:53.43 | 1st Qu.: 3.2323 | 1st Qu.: 0.6081 | 1st Qu.:7.799e+05 | 1st Qu.:9.367e+05 | 1st Qu.:49.62 | 1st Qu.:9.620e+05 | 1st Qu.:48.96 | 1st Qu.:2.759e+05 | 1st Qu.: -0.4648 | 1st Qu.:26.13 | 1st Qu.: 1.034 | 1st Qu.:3.439e+05 | 1st Qu.: 33.374 | 1st Qu.: 8.363 | 1st Qu.: 7.229 | 1st Qu.:28.007 | 1st Qu.: 6.514 | 1st Qu.: 0.534 | 1st Qu.: 56.7006 | 1st Qu.: 12.79 | |
| Mode :character | Mode :character | Median : 107160 | Median : 14.986 | Median : 6.455e+08 | Median :5.210e+09 | Median :1.329e+09 | Median :-1.701e+08 | Median : 0.000e+00 | Median : 2.269e+08 | Median :3.805e+09 | Median :1.231e+09 | Median : 0.000e+00 | Median : 1.366e+08 | Median : 99.573 | Median : 0.50 | Median : 64.68 | Median : 18.74 | Median : 3.241 | Median : 0.000 | Median : 15.376 | Median :5.000e+06 | Median : 0.037 | Median :18.890 | Median : 2.312 | Median : 7 | Median : 0.6308 | Median :0.3818 | Median : 9296 | Median : 4173 | Median : 70.345 | Median : 2.096 | Median : 92 | Median : 2.236 | Median : 33645 | Median : 990 | Median : 7927 | Median : 5.738 | Median : 3550.0 | Median : 9.399 | Median :34.44 | Median :18.61 | Median : 2.503 | Median :25.87 | Median : 68.891 | Median : 1287166 | Median : 30.936 | Median : 1999004 | Median : 4.899e+10 | Median : 67.41 | Median : 5.298 | Median : 6.80 | Median :2.115e+10 | Median :102.99 | Median :5.442e+09 | Median : 4.8 | Median :6.530e+09 | Median : 35.29 | Median : 67.681 | Median :12.805 | Median :51.39 | Median :1.244e+10 | Median : 3.642 | Median : 0.0000 | Median : 2515.6 | Median : 2.0261 | Median : 2.010 | Median : 3.666e+09 | Median : 20.72 | Median : 4.393e+09 | Median : 20.95 | Median :-1.190e+08 | Median :-4.527e+08 | Median : 9.781e+08 | Median : 7.882e+09 | Median : 2.837e+10 | Median :6.000 | Median : 25.637 | Median : 437764 | Median : 5770 | Median :24.390 | Median : 2.840 | Median :39.60 | Median :38.06 | Median :38.27 | Median :20.39 | Median :51.50 | Median :3.548e+06 | Median :24.04 | Median : 31.40 | Median :68.90 | Median :77.021 | Median :64.457 | Median :34.23 | Median :60.62 | Median : 4.7279 | Median : 1.5452 | Median :5.256e+06 | Median :3.264e+06 | Median :50.34 | Median :3.232e+06 | Median :49.66 | Median :2.267e+06 | Median : 0.6618 | Median :46.83 | Median : 2.358 | Median :2.373e+06 | Median : 53.175 | Median :12.544 | Median :12.115 | Median :40.716 | Median : 15.743 | Median : 3.480 | Median : 73.0276 | Median : 23.33 | |
| NA | NA | Mean : 2719581 | Mean : 22.455 | Mean : 3.749e+10 | Mean :1.813e+11 | Mean :4.890e+10 | Mean :-4.647e+08 | Mean :-1.817e+09 | Mean : 3.419e+10 | Mean :1.848e+11 | Mean :4.979e+10 | Mean : 7.930e+09 | Mean : 1.972e+09 | Mean : 81.600 | Mean :16.94 | Mean : 58.97 | Mean : 32.02 | Mean : 17.579 | Mean : 4.927 | Mean : 29.913 | Mean :7.828e+09 | Mean : 2.236 | Mean :30.297 | Mean : 2.329 | Mean : 91224 | Mean : 11.6703 | Mean :0.5440 | Mean : 530304 | Mean : 182783 | Mean : 67.147 | Mean : 4.763 | Mean : 219993 | Mean : 15.448 | Mean : 763288 | Mean : 51560 | Mean : 156238 | Mean : 8.864 | Mean : 58094.5 | Mean :10.795 | Mean :34.88 | Mean :20.21 | Mean : 4.863 | Mean :29.23 | Mean : 354.603 | Mean : 2947763 | Mean : 33.807 | Mean : 9328817 | Mean : 4.199e+13 | Mean : 75.44 | Mean : 26.320 | Mean : 22.95 | Mean :8.510e+11 | Mean :104.58 | Mean :2.126e+11 | Mean : 142.3 | Mean :2.082e+11 | Mean : 42.62 | Mean : 79.841 | Mean :13.316 | Mean :51.13 | Mean :7.288e+11 | Mean : 3.474 | Mean : 0.2636 | Mean : 9811.8 | Mean : 1.7913 | Mean : 6.486 | Mean : 2.239e+11 | Mean : 19.19 | Mean : 7.262e+10 | Mean : 21.11 | Mean :-4.071e+08 | Mean :-9.054e+11 | Mean : 1.486e+10 | Mean : 2.774e+12 | Mean : 2.973e+12 | Mean :6.154 | Mean : 28.088 | Mean : 12767600 | Mean : 173075 | Mean :29.433 | Mean : 3.195 | Mean :44.35 | Mean :42.57 | Mean :43.35 | Mean :20.06 | Mean :50.51 | Mean :7.299e+07 | Mean :26.40 | Mean : 44.95 | Mean :66.13 | Mean :71.801 | Mean :62.257 | Mean :33.09 | Mean :60.08 | Mean : 6.8313 | Mean : 1.6662 | Mean :1.248e+08 | Mean :6.770e+07 | Mean :50.08 | Mean :6.887e+07 | Mean :49.92 | Mean :6.957e+07 | Mean : 0.4594 | Mean :46.20 | Mean : 2.646 | Mean :5.576e+07 | Mean : 53.805 | Mean :14.034 | Mean :13.625 | Mean :41.452 | Mean : 26.770 | Mean : 16.105 | Mean : 68.0533 | Mean : 26.75 | |
| NA | NA | 3rd Qu.: 547566 | 3rd Qu.: 25.867 | 3rd Qu.: 5.462e+09 | 3rd Qu.:3.103e+10 | 3rd Qu.:8.885e+09 | 3rd Qu.:-3.929e+06 | 3rd Qu.: 2.950e+07 | 3rd Qu.: 2.442e+09 | 3rd Qu.:3.157e+10 | 3rd Qu.:8.472e+09 | 3rd Qu.: 9.700e+07 | 3rd Qu.: 4.751e+08 | 3rd Qu.:100.000 | 3rd Qu.:28.59 | 3rd Qu.: 91.11 | 3rd Qu.: 58.72 | 3rd Qu.: 23.129 | 3rd Qu.: 0.000 | 3rd Qu.: 55.624 | 3rd Qu.:5.790e+08 | 3rd Qu.: 1.473 | 3rd Qu.:51.876 | 3rd Qu.: 2.835 | 3rd Qu.: 9446 | 3rd Qu.: 17.0232 | 3rd Qu.:0.6505 | 3rd Qu.: 66838 | 3rd Qu.: 31005 | 3rd Qu.: 94.294 | 3rd Qu.: 6.263 | 3rd Qu.: 8870 | 3rd Qu.: 25.118 | 3rd Qu.: 121271 | 3rd Qu.: 6418 | 3rd Qu.: 31468 | 3rd Qu.: 9.933 | 3rd Qu.: 12887.5 | 3rd Qu.:15.000 | 3rd Qu.:47.14 | 3rd Qu.:25.96 | 3rd Qu.: 5.276 | 3rd Qu.:37.20 | 3rd Qu.: 160.677 | 3rd Qu.: 2996023 | 3rd Qu.: 43.035 | 3rd Qu.: 6761455 | 3rd Qu.: 6.330e+11 | 3rd Qu.: 100.00 | 3rd Qu.: 10.846 | 3rd Qu.: 41.06 | 3rd Qu.:1.363e+11 | 3rd Qu.:110.27 | 3rd Qu.:3.990e+10 | 3rd Qu.: 10.5 | 3rd Qu.:3.953e+10 | 3rd Qu.: 53.92 | 3rd Qu.: 99.047 | 3rd Qu.:17.665 | 3rd Qu.:59.64 | 3rd Qu.:9.368e+10 | 3rd Qu.: 5.997 | 3rd Qu.: 0.0909 | 3rd Qu.: 10076.1 | 3rd Qu.: 4.3111 | 3rd Qu.: 8.120 | 3rd Qu.: 3.573e+10 | 3rd Qu.: 27.93 | 3rd Qu.: 3.228e+10 | 3rd Qu.: 27.07 | 3rd Qu.: 0.000e+00 | 3rd Qu.: 0.000e+00 | 3rd Qu.: 6.071e+09 | 3rd Qu.: 1.007e+11 | 3rd Qu.: 2.456e+11 | 3rd Qu.:7.000 | 3rd Qu.: 35.323 | 3rd Qu.: 1888648 | 3rd Qu.: 42036 | 3rd Qu.:46.410 | 3rd Qu.: 4.560 | 3rd Qu.:76.19 | 3rd Qu.:63.22 | 3rd Qu.:66.77 | 3rd Qu.:25.63 | 3rd Qu.:65.82 | 3rd Qu.:1.219e+07 | 3rd Qu.:37.24 | 3rd Qu.: 66.80 | 3rd Qu.:73.94 | 3rd Qu.:84.559 | 3rd Qu.:73.931 | 3rd Qu.:43.20 | 3rd Qu.:66.11 | 3rd Qu.: 9.9052 | 3rd Qu.: 2.5797 | 3rd Qu.:1.945e+07 | 3rd Qu.:1.161e+07 | 3rd Qu.:51.04 | 3rd Qu.:1.155e+07 | 3rd Qu.:50.38 | 3rd Qu.:9.431e+06 | 3rd Qu.: 1.8421 | 3rd Qu.:66.63 | 3rd Qu.: 3.949 | 3rd Qu.:9.277e+06 | 3rd Qu.: 73.870 | 3rd Qu.:17.890 | 3rd Qu.:18.369 | 3rd Qu.:54.030 | 3rd Qu.: 41.402 | 3rd Qu.: 15.647 | 3rd Qu.: 84.2422 | 3rd Qu.: 36.79 | |
| NA | NA | Max. :129956634 | Max. :304.276 | Max. : 4.859e+12 | Max. :1.901e+13 | Max. :5.885e+12 | Max. : 2.578e+11 | Max. : 2.827e+11 | Max. : 4.790e+12 | Max. :1.926e+13 | Max. :6.246e+12 | Max. : 1.258e+12 | Max. : 1.678e+11 | Max. :100.000 | Max. :99.80 | Max. :100.00 | Max. :100.00 | Max. :100.000 | Max. :87.986 | Max. :100.000 | Max. :1.645e+12 | Max. :65.444 | Max. :98.343 | Max. :103.158 | Max. :7056781 | Max. :207.3675 | Max. :5.3510 | Max. :34041046 | Max. :10482498 | Max. :258.524 | Max. :360.853 | Max. :15291329 | Max. :216.648 | Max. :45873850 | Max. :3187680 | Max. :8174420 | Max. :192.227 | Max. :2986520.0 | Max. :48.431 | Max. :90.38 | Max. :81.25 | Max. :86.957 | Max. :96.97 | Max. :21388.600 | Max. :37468302 | Max. :100.000 | Max. :409712858 | Max. : 1.021e+16 | Max. :20422.89 | Max. :23773.132 | Max. :100.00 | Max. :8.715e+13 | Max. :261.43 | Max. :2.525e+13 | Max. :844788.2 | Max. :2.472e+13 | Max. :427.58 | Max. :860.800 | Max. :50.037 | Max. :96.20 | Max. :8.761e+13 | Max. :149.973 | Max. :22.4135 | Max. :190512.7 | Max. :140.3670 | Max. :87.507 | Max. : 2.348e+13 | Max. : 88.39 | Max. : 6.257e+12 | Max. : 100.67 | Max. : 2.923e+11 | Max. : 1.051e+14 | Max. : 7.741e+11 | Max. : 6.511e+14 | Max. : 4.503e+14 | Max. :8.000 | Max. :100.236 | Max. :601000000 | Max. :12493789 | Max. :92.370 | Max. :17.880 | Max. :99.38 | Max. :98.93 | Max. :98.96 | Max. :59.58 | Max. :89.94 | Max. :3.468e+09 | Max. :56.95 | Max. :219.30 | Max. :85.42 | Max. :96.093 | Max. :92.978 | Max. :51.57 | Max. :86.40 | Max. :28.3973 | Max. : 17.6334 | Max. :7.753e+09 | Max. :3.843e+09 | Max. :55.63 | Max. :3.907e+09 | Max. :76.71 | Max. :3.399e+09 | Max. : 29.6283 | Max. :97.16 | Max. : 48.936 | Max. :4.352e+09 | Max. :100.000 | Max. :62.416 | Max. :94.057 | Max. :98.467 | Max. :354.553 | Max. :359.256 | Max. :100.0000 | Max. : 100.00 | |
| NA | NA | NA’s :116 | NA’s :4044 | NA’s :3905 | NA’s :3840 | NA’s :3841 | NA’s :4105 | NA’s :4436 | NA’s :3912 | NA’s :3850 | NA’s :3833 | NA’s :4579 | NA’s :3739 | NA’s :5253 | NA’s :4731 | NA’s :4731 | NA’s :4731 | NA’s :4731 | NA’s :4835 | NA’s :5196 | NA’s :4725 | NA’s :4731 | NA’s :4776 | NA’s :4855 | NA’s :2159 | NA’s :2485 | NA’s :3095 | NA’s :1994 | NA’s :2112 | NA’s :2485 | NA’s :1997 | NA’s :2159 | NA’s :2485 | NA’s :1556 | NA’s :1112 | NA’s :1374 | NA’s :3270 | NA’s :1354 | NA’s :4839 | NA’s :4839 | NA’s :4839 | NA’s :4839 | NA’s :4839 | NA’s :139 | NA’s :3060 | NA’s :2726 | NA’s :4590 | NA’s :3622 | NA’s :3577 | NA’s :3398 | NA’s :4786 | NA’s :3396 | NA’s :3714 | NA’s :2950 | NA’s :4428 | NA’s :2949 | NA’s :2956 | NA’s :2957 | NA’s :3956 | NA’s :3821 | NA’s :1856 | NA’s :2111 | NA’s :2653 | NA’s :1859 | NA’s :2114 | NA’s :2009 | NA’s :3351 | NA’s :3305 | NA’s :5122 | NA’s :4902 | NA’s :2991 | NA’s :2952 | NA’s :4116 | NA’s :4072 | NA’s :4856 | NA’s :833 | NA’s :4628 | NA’s :3890 | NA’s :2094 | NA’s :5301 | NA’s :5301 | NA’s :5301 | NA’s :5301 | NA’s :5301 | NA’s :5301 | NA’s :5301 | NA’s :4938 | NA’s :815 | NA’s :1818 | NA’s :1022 | NA’s :1108 | NA’s :1108 | NA’s :927 | NA’s :927 | NA’s :927 | NA’s :35 | NA’s :32 | NA’s :950 | NA’s :927 | NA’s :950 | NA’s :927 | NA’s :83 | NA’s :462 | NA’s :60 | NA’s :85 | NA’s :83 | NA’s :60 | NA’s :4267 | NA’s :4275 | NA’s :3931 | NA’s :4301 | NA’s :4666 | NA’s :2228 | NA’s :4094 |
kable(summary(wdi_names)) %>% kable_styling("striped")
| Series Code | Series Name | |
|---|---|---|
| Length:214 | Length:214 | |
| Class :character | Class :character | |
| Mode :character | Mode :character |
Czyszczenie zbioru danych gold_prices obejmowało:
USD, która była średnią arytmetyczną kolumny USD..AM. oraz USD..PM., czyli cen zbieranych w godzinach porannych i popołudniowych.Date i USD.yyyy-mm-dd na wartość numeryczną timestamp.gold_prices_reshaped <- gold_prices %>%
mutate(USD = (USD..AM. + USD..PM.) / 2) %>%
select(Date, USD) %>%
mutate(Date = as.numeric(as.POSIXct(Date, format = "%Y-%m-%d")))
kable(summary(gold_prices_reshaped)) %>% kable_styling("striped")
| Date | USD | |
|---|---|---|
| Min. : -63075600 | Min. : 34.76 | |
| 1st Qu.: 360972000 | 1st Qu.: 281.60 | |
| Median : 784767600 | Median : 383.50 | |
| Mean : 784953601 | Mean : 576.75 | |
| 3rd Qu.:1208901600 | 3rd Qu.: 853.25 | |
| Max. :1632866400 | Max. :2058.15 | |
| NA | NA’s :144 |
Czyszczenie danych S&P Composite obejmowało
yyyy-mm-dd na wartość numeryczną.Year na Date.sp_reshaped <- sp_composite %>%
mutate(Year = as.numeric(as.POSIXct(Year, format = "%Y-%m-%d"))) %>%
rename(Date = Year) %>%
mutate_all(function(x) as.numeric(x)) %>%
drop_na()
kable(summary(sp_reshaped)) %>%
kable_styling("striped") %>%
scroll_box(width = "100%")
| Date | S.P.Composite | Dividend | Earnings | CPI | Long.Interest.Rate | Real.Price | Real.Dividend | Real.Earnings | Cyclically.Adjusted.PE.Ratio | |
|---|---|---|---|---|---|---|---|---|---|---|
| Min. :-2.806e+09 | Min. : 3.810 | Min. : 0.180 | Min. : 0.160 | Min. : 6.28 | Min. : 0.620 | Min. : 95.75 | Min. : 6.792 | Min. : 4.576 | Min. : 4.784 | |
| 1st Qu.:-1.698e+09 | 1st Qu.: 8.642 | 1st Qu.: 0.470 | 1st Qu.: 0.670 | 1st Qu.: 10.56 | 1st Qu.: 3.122 | 1st Qu.: 197.59 | 1st Qu.: 9.959 | 1st Qu.: 15.776 | 1st Qu.:11.890 | |
| Median :-5.906e+08 | Median : 23.780 | Median : 1.412 | Median : 2.417 | Median : 25.80 | Median : 3.710 | Median : 309.11 | Median :15.222 | Median : 26.696 | Median :16.372 | |
| Mean :-5.905e+08 | Mean : 341.689 | Mean : 7.192 | Mean : 16.438 | Mean : 65.57 | Mean : 4.493 | Mean : 649.80 | Mean :18.270 | Mean : 36.700 | Mean :17.168 | |
| 3rd Qu.: 5.172e+08 | 3rd Qu.: 237.850 | 3rd Qu.: 8.067 | 3rd Qu.: 15.182 | 3rd Qu.:109.45 | 3rd Qu.: 5.023 | 3rd Qu.: 734.41 | 3rd Qu.:23.398 | 3rd Qu.: 44.724 | 3rd Qu.:20.898 | |
| Max. : 1.625e+09 | Max. :4238.490 | Max. :59.680 | Max. :158.740 | Max. :271.70 | Max. :15.320 | Max. :4258.88 | Max. :63.511 | Max. :159.504 | Max. :44.198 |
Dane dotyczące bitcoina (bitcoin_mkpru, bitcoin_hrate, bitcoin_diff, bitcoin_trvou) zostały połączone w jeden zbiór danych za pomocą operacji inner_join. Ten sposób połączenia pozwolił na wyeliminowanie części wartości pustych.
Łączenie i czyszczenie obejmowało:
bitcoin_mkpru, bitcoin_hrate, bitcoin_diff, bitcoin_trvou za pomocą operacji inner_join.yyyy-mm-dd na wartość numeryczną timestamp.bitcoin_all <- inner_join(bitcoin_mkpru, bitcoin_diff, by = "Date") %>%
inner_join(bitcoin_hrate, by = "Date") %>%
inner_join(bitcoin_trvou, by = "Date") %>%
rename("mkpru" = `Value.x`, "diff" = `Value.y`, "hrate" = `Value.x.x`, "trvou" = `Value.y.y`) %>%
mutate(Date = as.numeric(as.POSIXct(Date, format = "%Y-%m-%d"))) %>%
mutate_at(2:5, function(x) as.numeric(x))
kable(summary(bitcoin_all)) %>% kable_styling("striped")
| Date | mkpru | diff | hrate | trvou | |
|---|---|---|---|---|---|
| Min. :1.231e+09 | Min. : 0.00 | Min. :0.000e+00 | Min. : 0 | Min. :0.000e+00 | |
| 1st Qu.:1.332e+09 | 1st Qu.: 7.21 | 1st Qu.:1.689e+06 | 1st Qu.: 12 | 1st Qu.:1.948e+05 | |
| Median :1.432e+09 | Median : 431.89 | Median :4.881e+10 | Median : 356089 | Median :6.824e+06 | |
| Mean :1.432e+09 | Mean : 5132.38 | Mean :3.665e+12 | Mean : 26458258 | Mean :1.467e+08 | |
| 3rd Qu.:1.533e+09 | 3rd Qu.: 6496.35 | 3rd Qu.:5.364e+12 | 3rd Qu.: 38265984 | 3rd Qu.:1.484e+08 | |
| Max. :1.633e+09 | Max. :63554.44 | Max. :2.505e+13 | Max. :198514006 | Max. :5.352e+09 |
Do sprawdzenia korelacji zostały wykorzystane jedynie kolumny numeryczne. Macierz korelacji została stworzona z wykorzystaniem funkcji cor z parametrem pairwise.complete.obs, który pomijał w obliczeniach pary, które zawierały wartości NA. Komórki znajdujące się na głównej przekątnej macierzy oraz ponad nią zostały usunięte. Następnie macierz została przetransformowana do tabeli, w której w wierszu znajdowały się wskaźniki gospodarcze oraz wartość korelacji pomiędzy nimi. Wybrane zostały korelacje z przedziału (0.75, 0.9), ponieważ wartości powyżej 0.9 wskazywały oczywiste związki między zmiennymi np. wzrost liczby ludności i wzrost liczby kobiet/mężczyzn w kraju.
wdi_cor_matrix <- wdi_reshaped %>%
select(3:115) %>%
cor(use = "pairwise.complete.obs")
wdi_cor_matrix[!lower.tri(wdi_cor_matrix)] <- NA
wdi_cor <- wdi_cor_matrix %>%
data.frame() %>%
rownames_to_column(var = "A") %>%
gather(key = "B", value = "Correlation", -A) %>%
filter(abs(Correlation) < 0.9 & abs(Correlation) > 0.75)
Do tabeli korelacji zostały dołączone opisy poszczególnych wskaźników w celu łatwiejszej interpretacji.
wdi_cor_names <- inner_join(wdi_cor, wdi_names, by = c("A" = "Series Code")) %>%
inner_join(wdi_names, by = c("B" = "Series Code")) %>%
mutate(A = `Series Name.x`, B = `Series Name.y`) %>%
select(-c(`Series Name.x`, `Series Name.y`))
prettyTable <- function(table_df, round_digits=2) {
DT::datatable(table_df, style="bootstrap", filter = "top", rownames = FALSE, extensions = "Buttons", options = list(dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))) %>% formatRound(names(dplyr::select_if(table_df, is.numeric)), round_digits)
}
prettyTable(wdi_cor_names)
p <- ggcorrplot(wdi_cor_matrix) +
labs(x = "Wskaźnik 1", y = "Wskaźnik 2") +
theme_classic() +
theme(axis.text = element_blank(), axis.ticks = element_blank())
ggplotly(p)
Z powyższych wyliczeń wynika, że emisja CO2 jest silnie skorelowana z importem oraz eksportem dóbr. Zależność jest widoczna między kolumnami: CO2 emissions from liquid fuel consumption (kt), CO2 emissions from gaseous fuel consumption (kt), a kolumnami: Goods exports (BoP, current US$), Goods imports (BoP, current US$). Współczynnik korelacji między kolumnami znajduje się w przedziale <0.80, 0.87> i zależność ta wskazuje na silną potrzebę rozwoju silników elektrycznych, które są mniej destrukcyjne dla środowiska.
co2_import_export <- wdi_reshaped %>%
select(c(`Year`, `Country Name`, `EN.ATM.CO2E.LF.KT`, `EN.ATM.CO2E.GF.KT`, `BM.GSR.MRCH.CD`, `BX.GSR.MRCH.CD`)) %>%
filter(`Country Name` == "United States")
co2_import_plot <- ggplot(co2_import_export, aes(x = Year, y = `BM.GSR.MRCH.CD`)) +
geom_point() +
theme(axis.text = element_blank(), axis.ticks = element_blank()) +
labs(x = "Rok", y = "Import dóbr")
co2_export_plot <- ggplot(co2_import_export, aes(x = Year, y = `BX.GSR.MRCH.CD`)) +
geom_point() +
theme(axis.text = element_blank(), axis.ticks = element_blank()) +
labs(x = "Rok", y = "Eksport dóbr")
co2_liq_plot <- ggplot(co2_import_export, aes(x = Year, y = `EN.ATM.CO2E.LF.KT`)) +
geom_point() +
theme(axis.text = element_blank(), axis.ticks = element_blank()) +
labs(x = "Rok", y = "CO2 (paliwo w stanie ciekłym)")
co2_gas_plot <- ggplot(co2_import_export, aes(x = Year, y = `EN.ATM.CO2E.GF.KT`)) +
geom_point() +
theme(axis.text = element_blank(), axis.ticks = element_blank()) +
labs(x = "Rok", y = "CO2 (paliwo w stanie gazowym)")
grid.arrange(co2_import_plot, co2_export_plot, co2_liq_plot, co2_gas_plot, ncol = 4)
population_comparison <- wdi_reshaped %>%
select(Year, `Country Name`, `SP.POP.TOTL.MA.IN`, `SP.POP.TOTL.FE.IN`) %>%
filter(`Country Name` %in% c("China", "United States", "India")) %>%
mutate(Year = as.numeric(Year))
plot <- population_comparison %>%
mutate(`SP.POP.TOTL.MA.IN` = `SP.POP.TOTL.MA.IN` / 1000000000, `SP.POP.TOTL.FE.IN` = `SP.POP.TOTL.FE.IN` / 1000000000) %>%
ggplot(aes(x = Year)) +
geom_line(aes(y = `SP.POP.TOTL.MA.IN`, color = "Mezczyzni")) +
geom_line(aes(y = `SP.POP.TOTL.FE.IN`, color = "Kobiety")) +
facet_grid(. ~ `Country Name`) +
labs(x = "Rok", y = "Populacja [mld]", color = "Plec")
plot.animation <- plot +
transition_reveal(Year)
animate(plot.animation, renderer = gifski_renderer())
Wykres wskazuje znaczny wzrost populacji kobiet i meżczyzn zarówno w Chinach jak i Indiach, przy stopniowym wzroście w USA. Na zmniejszenie dynamiki wzrostu liczby ludności w Chinach ma wpływ prawdopodobnie polityka jednego dziecka obowiązująca w latach 1977-2015. Z tego również względu wynikać może spora różnica między populacją kobiet i mężczyzn, ponieważ rodziny mogły mieć jedno dziecko (większa liczba powodowała problemy ekonomiczne narzucone przez państwo) i bardziej preferowany był syn niż córka, co jest częstym zjawiskiem w krajach azjatyckich np. Indie. W krajach zachodnich różnica między populacją kobiet i mężczyzn jest niska tak jak wskazuje powyższy wykres dla kraju USA.
Do stworzenia regresora potrzebne były informacje, które pozwolą na jak najlepszą predykcję ceny bitcoina, dlatego sprawdzona została korelacja między kolumnami w zbiorach bitcoin_all, gold_prices_reshaped i sp_reshaped. Najpierw, dane dotyczące bitcoina zostały połączone ze zbiorem z cenami złota po kolumnie Date z wykorzystaniem funkcji inner_join, aby zmniejszyć występowanie wartości pustych. Następnie do wynikowego zbioru został dołączony zbiór sp_reshaped z wykorzystaniem operacji left_join. Różnica w sposobie połączenia wynikała z tego, że dane dotyczące bitcoina oraz cen złota były zbierane codziennie, natomiast informacje zawarte w zbiorze sp_reshaped dotyczyły każdego miesiąca. Taki sposób połączenia pozwolił na wypełnienie wartości pustych występujących w każdym dniu danego miesiąca przez wykorzystanie funkcji fill z parametrem downup.
bitcoin_gold_sp <- inner_join(bitcoin_all, gold_prices_reshaped, by = "Date") %>%
left_join(sp_reshaped, by = "Date") %>%
mutate_all(function(x) as.numeric(x)) %>%
fill(7:15, .direction = "downup")
bitcoin_gold_sp_cor_matrix <- bitcoin_gold_sp %>%
select(2:15) %>%
cor(use = "pairwise.complete.obs")
bitcoin_gold_sp_cor_matrix[!lower.tri(bitcoin_gold_sp_cor_matrix)] <- NA
p <- ggcorrplot(bitcoin_gold_sp_cor_matrix) +
theme_classic() +
theme(axis.title = element_blank(), axis.ticks = element_blank(), axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
ggplotly(p)
Zostały wybrane te kolumny, które z kolumną mkpru (ceną bitcoina) najbardziej korelują (współczynnik korelacji większy od 0.5) i posłużą do stworzenia regresora przewidującego cenę bitcoina.
bitcoin_gold_sp_cor <- bitcoin_gold_sp_cor_matrix %>%
data.frame() %>%
rownames_to_column(var = "A") %>%
gather(key = "B", value = "Correlation", -A) %>%
filter((A == "mkpru" | B == "mkpru") & abs(Correlation) > 0.5)
prettyTable(bitcoin_gold_sp_cor)
bitcoin_reg <- bitcoin_gold_sp %>%
select(c(Date, mkpru, diff, hrate, trvou, `S.P.Composite`, Dividend, CPI, `Real.Price`, `Real.Dividend`, `Cyclically.Adjusted.PE.Ratio`))
Zbiór bitcoin_reg zawierający wszystkie statystyki dotyczące bitcoina, cen złota oraz S&P Composite został podzielony na zbiór uczący oraz testowy w sposób losowy w stosunku 1:3. Zbiór walidujący został stworzony wykorzystując powtarzaną ocenę krzyżową z liczbą podziałów 2 i liczbą powtórzeń 5.
bitcoin_in_training <- createDataPartition(y = bitcoin_reg$mkpru, p = 0.75, list = FALSE)
bitcoin_training <- bitcoin_reg[bitcoin_in_training,] %>% as.data.frame()
bitcoin_testing <- bitcoin_reg[-bitcoin_in_training,] %>% as.data.frame()
bitcoin_ctrl <- trainControl(method = "repeatedcv", number = 2, repeats = 5)
Poniższy wykres przedstawia podobieństwo rozkładów danych uczących i testowych.
ggplot() +
geom_density(aes(mkpru, fill = "Uczący"), bitcoin_training, alpha = 0.6) +
geom_density(aes(mkpru, fill = "Testowy"), bitcoin_testing, alpha = 0.6) +
labs(x = "mkpru", y = "Gęstość", fill = "Zbiór")
Pierwszy model został stworzony z wykorzystaniem algorytmu lasso.
bitcoin_fit_lasso <- train(mkpru ~ ., data = bitcoin_training, method = "lasso")
ggplot(varImp(bitcoin_fit_lasso)) +
labs(x = "Ważność", y = "Cecha")
bitcoin_lasso_predicted <- predict(bitcoin_fit_lasso, bitcoin_testing) %>%
as.data.frame()
Do oceny predykcji wykorzystane zostały dwie miary: R2 oraz RMSE.
lasso_rmse <- RMSE(unlist(bitcoin_lasso_predicted), bitcoin_testing$mkpru)
lasso_r2 <- R2(unlist(bitcoin_lasso_predicted), bitcoin_testing$mkpru)
print(paste("RMSE: ", lasso_rmse))
print(paste("R2: ", lasso_r2))
## [1] "RMSE: 2962.21485075706"
## [1] "R2: 0.92053793575698"
Poniższy wykres przedstawia wartości zbioru testowego i wartości wynikowe modelu
bitcoin_predicted_lasso_compare <- data.frame(date = bitcoin_testing$Date, actual = bitcoin_testing$mkpru, predicted = bitcoin_lasso_predicted$.)
ggplot(bitcoin_predicted_lasso_compare, aes(x = date)) +
geom_line(aes(y = actual, color = "Testowe")) +
geom_line(aes(y = predicted, color = "Lasso")) +
labs(color = "Wartości", x = "Data", y = "mkpru") +
theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())
Kolejny model został stworzony z wykorzystaniem algorytmu ridge.
bitcoin_fit_ridge <- train(mkpru ~ ., data = bitcoin_training, method = "ridge")
ggplot(varImp(bitcoin_fit_ridge)) +
labs(x = "Ważność", y = "Cecha")
bitcoin_ridge_predicted <- predict(bitcoin_fit_ridge, bitcoin_testing) %>%
as.data.frame()
Do oceny predykcji wykorzystane zostały dwie miary: R2 oraz RMSE.
ridge_rmse <- RMSE(unlist(bitcoin_ridge_predicted), bitcoin_testing$mkpru)
ridge_r2 <- R2(unlist(bitcoin_ridge_predicted), bitcoin_testing$mkpru)
print(paste("RMSE: ", ridge_rmse))
print(paste("R2: ", ridge_r2))
## [1] "RMSE: 2970.46587524583"
## [1] "R2: 0.920568177822367"
Poniższy wykres przedstawia wartości zbioru testowego i wartości wynikowe modelu
bitcoin_predicted_ridge_compare <- data.frame(date = bitcoin_testing$Date, actual = bitcoin_testing$mkpru, predicted = bitcoin_ridge_predicted$.)
ggplot(bitcoin_predicted_ridge_compare, aes(x = date)) +
geom_line(aes(y = actual, color = "Testowe")) +
geom_line(aes(y = predicted, color = "Ridge")) +
labs(color = "Wartości", x = "Data", y = "mkpru") +
theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())
model_list <- list(lasso = bitcoin_fit_lasso, ridge = bitcoin_fit_ridge)
res <- resamples(model_list)
summary(res)
bitcoin_predicted_compare <- data.frame(date = bitcoin_testing$Date, actual = bitcoin_testing$mkpru, predicted_lasso = bitcoin_lasso_predicted$., predicted_ridge = bitcoin_ridge_predicted$.)
ggplot(bitcoin_predicted_compare, aes(x = date)) +
geom_line(aes(y = actual, color = "Testowe")) +
geom_line(aes(y = predicted_lasso, color = "Lasso")) +
geom_line(aes(y = predicted_ridge, color = "Ridge")) +
labs(color = "Wartości", x = "Data", y = "mkpru") +
theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())